home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / HSBASIC2.DMS / in.adf / HB2Examples2.0.Lha / Examples / HBMsg / HBMsg.bas < prev    next >
Encoding:
BASIC Source File  |  1994-05-10  |  33.7 KB  |  1,085 lines
  1. ''
  2. '' $Id: HBMsg.bas,v 1.2 1994/05/10 14:46:07 alex Rel $
  3. ''
  4. '' Simple BASIC Message Browser AREXX host
  5. ''
  6. '' (c) Copyright 1994 HiSoft
  7. ''
  8.  
  9. REM $NOWINDOW
  10.  
  11. DEFINT A-Z
  12.  
  13. 'REM $INCLUDE Exec.bh
  14. 'REM $INCLUDE DOS.bh
  15. 'REM $INCLUDE Locale.bh
  16. 'REM $INCLUDE Layers.bh
  17. 'REM $INCLUDE Hardware.bc
  18. 'REM $INCLUDE Graphics.bh
  19. 'REM $INCLUDE Input.bc
  20. 'REM $INCLUDE KeyMap.bh
  21. 'REM $INCLUDE Intuition.bh
  22. 'REM $INCLUDE Icon.bh
  23. 'REM $INCLUDE Workbench.bc
  24. 'REM $INCLUDE Rexx.bh
  25. 'REM $INCLUDE Utility.bc
  26.  
  27. DIM SHARED pool&, tl&(40), junk&
  28.  
  29. REM $INCLUDE BLib/ExecSupport.bas
  30. REM $INCLUDE BLib/PoolSupport.bas
  31. REM $INCLUDE BLib/GfxMacros.bas
  32. REM $INCLUDE BLib/BusyPointer.bas
  33.  
  34. LIBRARY OPEN "exec.library", 36
  35. LIBRARY OPEN "dos.library", 36
  36. LIBRARY OPEN "layers.library", LIBRARY_MINIMUM&
  37. LIBRARY OPEN "graphics.library", LIBRARY_MINIMUM&
  38. LIBRARY OPEN "keymap.library", 36
  39. LIBRARY OPEN "intuition.library", 36
  40. LIBRARY OPEN "icon.library", 36
  41. LIBRARY OPEN "rexxsyslib.library", LIBRARY_MINIMUM&
  42.  
  43. ' options stuff (must match the template!)
  44. CONST OPT_PUBSCREEN = 0
  45. CONST OPT_PORTNAME = 1
  46. DIM SHARED opts&(1)    ' number of options
  47.  
  48. CONST PROP_LGAP_LOWRES = 3    ' offset from right border start
  49. CONST PROP_RGAP_LOWRES = 3    ' from right edge of window
  50. CONST PROP_LGAP_MEDRES = 4    ' offset from right border start
  51. CONST PROP_RGAP_MEDRES = 4    ' from right edge of window
  52.  
  53. CONST PROP_TGAP = 2    ' offset from bottom border start
  54. CONST PROP_BGAP = 2    ' from bottom edge of window
  55.  
  56. CONST PROP_VGAP = 1    ' between window border and gadget
  57.  
  58. FUNCTION createRXPort&(BYVAL pName&)
  59.     STATIC portName&, port&
  60.  
  61.     createRXPort& = NULL&
  62.     ' allocate name space + space for pending replies counter
  63.     portName& = LibAllocVecPooled&(pool&, LEN(PEEK$(pName&)) + 1 + 4)
  64.     IF portName& <> NULL& THEN
  65.         CopyMem pName&, portName& + 4, LEN(PEEK$(pName&)) + 1
  66.         port& = CreateMsgPort&    ' create the message port before the Forbid
  67.         IF port& THEN
  68.             POKEL portName&, 0    ' number of pending replies at this port
  69.             POKEL port& + mp_Node + ln_Name, portName& + 4
  70.             POKEB port& + mp_Node + ln_Pri, 0
  71.             Forbid    ' stop anything happening on the public port list
  72.             IF FindPort&(portName&) = NULL& THEN
  73.                 AddPort port&
  74.                 Permit
  75.                 createRXPort& = port&
  76.             ELSE
  77.                 Permit
  78.                 LibFreeVecPooled pool&, portName&
  79.                 DeleteMsgPort port&
  80.             END IF
  81.         ELSE
  82.             LibFreeVecPooled pool&, portName&
  83.         END IF
  84.     END IF
  85. END FUNCTION
  86.  
  87. FUNCTION parseRXArgs&(rxArg$, rxTemplate$, BYVAL prxArg&)
  88.     STATIC rda&, csb$
  89.  
  90.     parseRXArgs& = NULL&
  91.     rda& = AllocDosObject&(DOS_RDARGS&, NULL&)
  92.     IF rda& <> NULL& THEN
  93.         csb$ = rxArg$ + CHR$(10) + CHR$(0)    ' build input string (with \n for bug)
  94.         POKEL rda& + RDA_Source + CS_Buffer, SADD(csb$)
  95.         POKEL rda& + RDA_Source + CS_Length, LEN(csb$)
  96.         POKEL rda& + RDA_Source + CS_CurChr, 0
  97.         POKEL rda& + RDA_DAList, NULL&
  98.         POKEL rda& + RDA_Buffer, NULL&
  99.         POKEL rda& + RDA_Flags, RDAF_NOPROMPT&
  100.  
  101.         IF ReadArgs&(SADD(rxTemplate$ + CHR$(0)), prxArg&, rda&) <> NULL& THEN
  102.             parseRXArgs& = rda&    ' success return the ReadArgs context
  103.         ELSE
  104.             FreeArgs rda&
  105.             FreeDosObject DOS_RDARGS&, rda&
  106.         END IF
  107.     END IF
  108. END FUNCTION
  109.  
  110. SUB disposeRXArgs(BYVAL rda&)
  111.     IF rda& <> NULL& THEN
  112.         FreeArgs rda&
  113.         FreeDosObject DOS_RDARGS&, rda&
  114.     END IF
  115. END SUB
  116.  
  117. SUB disposeRXCommand(BYVAL port&, BYVAL rxMsg&)
  118.     ' decrement number of replies pending at this port
  119.     POKEL PEEKL(port& + mp_node + ln_Name) - 4, _
  120.       PEEKL(PEEKL(port& + mp_node + ln_Name) - 4) - 1
  121.     IF PEEKL(rxMsg& + rm_Result1) = 0 AND PEEKL(rxMsg& + rm_Result2) THEN
  122.         DeleteArgstring PEEKL(rxMsg& + rm_Result2)
  123.     END IF
  124.  
  125.     DeleteArgstring PEEKL(rxMsg& + rm_Args)
  126.     DeleteRexxMsg rxMsg&
  127. END SUB
  128.  
  129. FUNCTION issueRXCommand&(BYVAL port&, cmd$, ext$)
  130.     STATIC rxMsg&, rxArgs&, rxPort&
  131.  
  132.     issueRXCommand& = NULL&
  133.  
  134.     ' create a REXX message context
  135.     rxMsg& = CreateRexxMsg&(port&, SADD(ext$ + CHR$(0)), PEEKL(port& + mp_Node + ln_Name))
  136.     IF rxMsg& <> NULL& THEN
  137.         ' get a REXX arg string
  138.         rxArgs& = CreateArgstring&(SADD(cmd$ + CHR$(0)), LEN(cmd$))
  139.         IF rxArgs& <> NULL& THEN
  140.             POKEL rxMsg& + rm_Action, RXCOMM& OR RXFF_RESULT&
  141.             POKEL rxMsg& + rm_Stdin, xInput&
  142.             POKEL rxMsg& + rm_Stdout, xOutput&
  143.             POKEL rxMsg& + rm_Args, rxArgs&
  144.             Forbid
  145.             rxPort& = FindPort&(SADD("REXX" + CHR$(0)))
  146.             IF rxPort& <> NULL& THEN
  147.                 PutMsg rxPort&, rxMsg&
  148.                 Permit
  149.  
  150.                 ' increment number of replies pending at this port
  151.                 POKEL PEEKL(port& + mp_node + ln_Name) - 4, _
  152.                   PEEKL(PEEKL(port& + mp_node + ln_Name) - 4) + 1
  153.                 issueRXCommand& = rxMsg&
  154.             ELSE
  155.                 Permit
  156.                 DeleteArgString rxArgs&
  157.                 DeleteRexxMsg rxMsg&
  158.             END IF
  159.         ELSE
  160.             DeleteRexxMsg rxMsg&
  161.         END IF
  162.     END IF
  163. END FUNCTION
  164.  
  165. SUB disposeRXPort(BYVAL port&)
  166.     STATIC msg&
  167.  
  168.     RemPort port&
  169.     ' wait for all pending messages to return
  170.     WHILE PEEKL(PEEKL(port& + mp_node + ln_Name) - 4) <> 0
  171.         junk& = WaitPort&(port&)
  172.         msg& = GetMsg&(port&)
  173.         WHILE msg& <> NULL&
  174.             IF PEEKB(msg& + rm_Node + mn_Node + ln_Type) = NT_REPLYMSG& THEN
  175.                 disposeRXCommand port&, msg&
  176.             ELSE
  177.                 POKEL msg& + rm_Result1, ERR10_013&    ' host environment not found
  178.                 ReplyMsg msg&
  179.             END IF
  180.             msg& = GetMsg&(port&)
  181.         WEND
  182.     WEND
  183.     LibFreeVecPooled pool&, PEEKL(port& + mp_Node + ln_Name) - 4
  184.     DeleteMsgPort port&
  185. END SUB
  186.  
  187. DIM SHARED errList&
  188.  
  189. DIM SHARED render(RastPort_sizeof \ 2)
  190. DIM SHARED selren(RastPort_sizeof \ 2)
  191. DIM SHARED clr(RastPort_sizeof \ 2)
  192.  
  193. ' view information for the error list
  194. DIM SHARED numLines
  195. DIM SHARED topLine&
  196. DIM SHARED linesVisible
  197. DIM SHARED currentLine&
  198.  
  199. FUNCTION dispatchRXMsg(rxStr$)
  200.     STATIC rxCommand$, rxArg$, rxTemplate$, n, rda&, msgNode&
  201.  
  202.     dispatchRXMsg = FALSE&
  203.  
  204.     ' Brute force and ignorance command parser... (_very_ slow)
  205.     n = INSTR(rxStr$, " ")    ' find end of command
  206.     IF n = 0 THEN
  207.         rxCommand$ = rxStr$    ' no space, entire string is the command
  208.         rxArg$ = ""
  209.     ELSE
  210.         rxCommand$ = UCASE$(LEFT$(rxStr$, n - 1))    ' extract the command
  211.         rxArg$ = MID$(rxStr$, n + 1)    ' and arguments
  212.     END IF
  213.  
  214.     IF rxCommand$ = "QUIT" THEN
  215.         rxTemplate$ = ""
  216.         dispatchRXMsg = TRUE&
  217.     ELSEIF rxCommand$ = "NEWMSG" THEN
  218.         rxTemplate$ = "UNIT/A,FILE/A,LINE/N/A,POSITION/N/A,NULL/A,ZERO/N/A,CLASS/A,ERRNUM/A/N,MESSAGE/F"
  219.         msgNode& = LibAllocVecPooled&(pool&, Node_sizeof + 4 + 9 * 4)    ' 9 template items
  220.         IF msgNode& THEN
  221.             rda& = parseRXArgs&(rxArg$, rxTemplate$, msgNode& + Node_sizeof + 4)
  222.             IF rda& THEN
  223.                 POKEL msgNode& + Node_sizeof, rda&
  224.                 AddTail errList&, msgNode&
  225.                 INCR numlines
  226.             ELSE
  227.                 LibFreeVecPooled pool&, msgNode&
  228.             END IF
  229.         END IF
  230.     END IF
  231. END FUNCTION
  232.  
  233. ' Render a single line of text at a given position
  234. SUB RenderLine(BYVAL x, BYVAL y, BYVAL w, BYVAL l&)
  235.     STATIC ltext$, prxArgs&, llen, rp&
  236.     SHARED columnsVisible, fntHeight
  237.  
  238.     IF l& = currentLine& THEN
  239.         rp& = VARPTR(selren(0))
  240.     ELSE
  241.         rp& = VARPTR(render(0))
  242.     END IF
  243.  
  244.     Move rp&, x, y    ' move the cursor to the position
  245.  
  246.     prxArgs& = l& + Node_sizeof + 4
  247.     ltext$ = PEEK$(FilePart&(PEEKL(prxArgs& + 1 * 4))) + "(" + _
  248.       PEEK$(FilePart&(PEEKL(prxArgs& + 0 * 4))) + "):" + _
  249.       LTRIM$(STR$(PEEKL(PEEKL(prxArgs& + 2 * 4)))) + ":" + _
  250.       PEEK$(PEEKL(prxArgs& + 6 * 4)) + STR$(PEEKL(PEEKL(prxArgs& + 7 * 4))) + " """ + _
  251.       PEEK$(PEEKL(prxArgs& + 8 * 4)) + """"
  252.     llen = LEN(ltext$)
  253.  
  254.     IF llen > columnsVisible THEN    ' is line is longer than allowed?
  255.         llen = columnsVisible        ' yes, so reduce its length
  256.     END IF
  257.  
  258.     Text rp&, SADD(ltext$), llen    ' write to the window
  259.  
  260.     IF llen < columnsVisible THEN
  261.         RectFill VARPTR(clr(0)), PEEKW(rp& + cp_x), _
  262.           y - PEEKW(rp& + TxBaseline), _
  263.           x + w - 1, y - PEEKW(rp& + TxBaseline) + fntHeight - 1
  264.     END IF
  265. END SUB
  266.  
  267. FUNCTION firstVisibleLine&
  268.     STATIC l&, i
  269.  
  270.     IF PEEKL(errList& +    lh_TailPred) == errList& THEN
  271.         ' no nodes
  272.         firstVisibleLine& = NULL&
  273.     ELSE
  274.         l& = PEEKL(errList& + lh_Head)
  275.         i = topLine&
  276.         WHILE PEEKL(l& + ln_Succ) AND i <> 0
  277.             DECR i
  278.             l& = PEEKL(l& + ln_Succ)
  279.         WEND
  280.         firstVisibleLine& = l&
  281.     END IF
  282. END FUNCTION
  283.  
  284. ' This function performs most of the rendering work needed by our sample.
  285. ' It first locks the window's layer to insure it doesn't get sized during
  286. ' the rendering process. It then looks at the current window size and
  287. ' adjusts its rendering variables in consequence. If the damage parameter
  288. ' is set to TRUE, the routine then proceeds to explicitly erase any area
  289. ' of the display to which we will not be rendering in the rendering loop.
  290. ' This erases any left over characters that could be left if the user sizes
  291. ' the window smaller. Finally, the routine determines which lines of the
  292. ' display need to be updated and goes on to do it.
  293. '
  294. SUB RefreshView(BYVAL damage)
  295.     STATIC i, x, y, l&
  296.     STATIC fontWidth, viewHeight, viewWidth, usefulWidth, usefulHeight
  297.     SHARED columnsVisible, fntHeight
  298.     SHARED win&
  299.     STATIC oldTopLine&
  300.  
  301.     ' lock the window's layer so its size will not change
  302.     LockLayer NULL&, PEEKL(win& + WLayer)
  303.  
  304.     ' determine various values based on the current size of the window
  305.     viewWidth = PEEKW(win& + WindowWidth) - PEEKB(win& + BorderLeft) - PEEKB(win& + BorderRight)
  306.     fontWidth = PEEKW(PEEKL(PEEKL(win& + RPort) + RastPortFont) + tf_XSize)
  307.     columnsVisible = viewWidth \ fontWidth
  308.  
  309.     viewHeight = PEEKW(win& + WindowHeight) - PEEKB(win& + BorderTop) - PEEKB(win& + BorderBottom)
  310.     linesVisible = viewHeight \ fntHeight
  311.  
  312.     usefulWidth = columnsVisible * fontWidth
  313.  
  314.     IF linesVisible > numLines THEN
  315.         usefulHeight = numLines * fntHeight
  316.         topLine& = 0
  317.     ELSEIF topLine& + linesVisible > numLines THEN
  318.         topLine& = numLines - linesVisible
  319.         usefulHeight = (numLines - topLine&) * fntHeight
  320.     ELSE
  321.         usefulHeight = linesVisible * fntHeight
  322.     END IF
  323.  
  324.     ' if we were called because of damage, we must erase any left over garbage
  325.     IF damage <> FALSE& THEN
  326.         ' erase anything left over on the right side of the window
  327.         IF PEEKB(win& + BorderLeft) + usefulWidth < PEEKW(win& + WindowWidth) - PEEKB(win& + BorderRight) AND _
  328.           usefulHeight <> 0 THEN
  329.             RectFill VARPTR(clr(0)), PEEKB(win& + BorderLeft) + usefulWidth, _
  330.               PEEKB(win& + BorderTop), _
  331.               PEEKW(win& + WindowWidth) - PEEKB(win& + BorderRight) - 1, _
  332.               PEEKB(win& + BorderTop) + usefulHeight - 1
  333.         END IF
  334.  
  335.         ' erase anything left over on the bottom of the window
  336.         IF (PEEKB(win& + BorderLeft) < PEEKW(win& + WindowWidth) - PEEKB(win& + BorderRight)) AND _
  337.           (PEEKB(win& + BorderTop) + usefulHeight < PEEKW(win& + WindowHeight) - PEEKB(win& + BorderBottom)) THEN
  338.             RectFill VARPTR(clr(0)), PEEKB(win& + BorderLeft), _
  339.               PEEKB(win& + BorderTop) + usefulHeight, _
  340.               PEEKW(win& + WindowWidth) - PEEKB(win& + BorderRight) - 1, _
  341.               PEEKW(win& + WindowHeight) - PEEKB(win& + BorderBottom) - 1
  342.         END IF
  343.     END IF
  344.  
  345.     ' if we have at least one line and one column to render...
  346.     IF usefulHeight <> 0 AND usefulWidth <> 0 THEN
  347.         ' get a pointer to the first line currently visible
  348.         l& = firstVisibleLine&
  349.  
  350.         IF damage <> FALSE& OR _
  351.           (topLine& >= oldTopLine& + linesVisible - 1) OR _
  352.           ((oldTopLine& > linesVisible) AND (topLine& <= oldTopLine& - linesVisible + 1)) THEN
  353.             ' the whole display must be redrawn
  354.             x = PEEKB(win& + BorderLeft)
  355.             y = PEEKB(win& + BorderTop) + PEEKW(PEEKL(PEEKL(win& + RPort) + RastPortFont) + tf_Baseline)
  356.             i = linesVisible
  357.         ELSEIF topLine& < oldTopLine& THEN
  358.             ' we just need to scroll the text
  359.             ScrollRaster VARPTR(render(0)), 0, -((oldTopLine& - topLine&) * fntHeight), _
  360.               PEEKB(win& + BorderLeft), _
  361.               PEEKB(win& + BorderTop), _
  362.               PEEKB(win& + BorderLeft) + usefulWidth - 1, _
  363.               PEEKB(win& + BorderTop) + usefulHeight - 1 _
  364.  
  365.             ' indicates what section needs to be redrawn
  366.             x = PEEKB(win& + BorderLeft)
  367.             y = PEEKB(win& + BorderTop) + PEEKW(PEEKL(PEEKL(win& + RPort) + RastPortFont) + tf_Baseline)
  368.             i = oldTopLine& - topLine&
  369.         ELSEIF topLine& > oldTopLine& THEN
  370.             ' we just need to scroll the text
  371.             ScrollRaster VARPTR(render(0)), 0, (topLine& - oldTopLine&) * fntHeight, _
  372.               PEEKB(win& + BorderLeft), _
  373.               PEEKB(win& + BorderTop), _
  374.               PEEKB(win& + BorderLeft) + usefulWidth - 1, _
  375.               PEEKB(win& + BorderTop) + usefulHeight - 1
  376.  
  377.             ' indicates what section needs to be redrawn
  378.             i = linesVisible - (topLine& - oldTopLine&)
  379.             WHILE PEEKL(l& + ln_Succ) AND i <> 0
  380.                 DECR i
  381.                 l& = PEEKL(l& + ln_Succ)
  382.             WEND
  383.  
  384.             x = PEEKB(win& + BorderLeft)
  385.             y = PEEKB(win& + BorderTop) + _
  386.               PEEKW(PEEKL(PEEKL(win& + RPort) + RastPortFont) + tf_Baseline) + _
  387.               (fntHeight * (linesVisible - (topLine& - oldTopLine&)))
  388.             i = topLine& - oldTopLine&
  389.         ELSE
  390.             ' we don't need to render anything
  391.             i = 0
  392.         END IF
  393.  
  394.         ' render all the lines we need
  395.         WHILE PEEKL(l& + ln_Succ) AND i <> 0
  396.             DECR i
  397.             RenderLine x, y, usefulWidth, l&
  398.             y = y + fntHeight
  399.             l& = PEEKL(l& + ln_Succ)
  400.         WEND
  401.     END IF
  402.  
  403.     ' unlock the layer so normal operations can resume
  404.     UnlockLayer PEEKL(win& + WLayer)
  405.  
  406.     ' keep track of what the current top line is. That way, when we
  407.     ' come back in this routine later, and "topLine" has changed, we
  408.     ' can tell how many lines we need to scroll in order to sync up the
  409.     ' display
  410.     oldTopLine& = topLine&
  411. END SUB
  412.  
  413. ' This is the message packet passed by layers.library to a backfill hook.
  414. ' It contains a pointer to the layer that has been damaged, a Rectangle
  415. ' structure that defines the bounds of the damage. No rendering can occur
  416. ' outside of these coordinates.
  417. '
  418. ' The backfill hook is also passed a RastPort in which the rendering
  419. ' should be performed
  420.  
  421. CONST bf_Layer = 0
  422. CONST bf_Bounds = 4
  423. CONST bf_OffsetX = 8
  424. CONST bf_OffsetY = 12
  425. CONST BackFillMsg_sizeof = 16
  426.  
  427. SUB BackFillHook(BYVAL hook&, BYVAL rp&, BYVAL bfm&)
  428.     LOCAL crp&
  429.     SHARED taskBusy
  430.  
  431.     crp& = AllocMem&(RastPort_sizeof, MEMF_ANY&)
  432.     IF crp& <> NULL& THEN
  433.         CopyMem rp&, crp&, RastPort_sizeof    ' copy the rastport
  434.         POKEL crp& + Layer, NULL&    ' eliminate bogus clipping from our copy
  435.  
  436.         IF taskBusy = TRUE& THEN
  437.             SafeSetWriteMask crp&, &hFF    ' if the main task is busy, clear all planes
  438.         ELSE
  439.             SafeSetWriteMask crp&, &hFE    ' otherwise, clear all planes except plane 0
  440.         END IF
  441.  
  442.         SetAPen crp&, 0        ' set the pen to color 0
  443.         SetDrMd crp&, JAM2&    ' set the rendering mode we need
  444.  
  445.         ' clear the whole area
  446.         RectFill crp&, PEEKW(bfm& + bf_Bounds + RectangleMinX), _
  447.           PEEKW(bfm& + bf_Bounds + RectangleMinY), _
  448.           PEEKW(bfm& + bf_Bounds + RectangleMaxX), _
  449.           PEEKW(bfm& + bf_Bounds + RectangleMaxY)
  450.         FreeMem crp&, RastPort_sizeof
  451.     END IF
  452. END SUB
  453.  
  454. FUNCTION newVScroller&(BYVAL bottomspace)
  455.     STATIC sizeim&, height, proplgap, proprgap, lt, borderless&
  456.     SHARED dri&, scr&, sizeim&
  457.  
  458.     ' guesstimate the resolution
  459.     proplgap = PROP_LGAP_LOWRES
  460.     proprgap = PROP_RGAP_LOWRES
  461.     IF PEEKW(dri& + DrawInfoX) <= 22 THEN
  462.         proplgap = PROP_LGAP_MEDRES
  463.         proprgap = PROP_RGAP_MEDRES
  464.     END IF
  465.  
  466.     ' take into account the Workbench look for sliders
  467.     IF PEEKW(LIBRARY("intuition.library") + IntuitionBaseLibNode + lib_Version) >= 39 THEN
  468.         borderless& = TRUE&
  469.     ELSE
  470.         borderless& = FALSE&
  471.     END IF
  472.  
  473.     ' generate the scroll gadget
  474.     height = PEEKB(scr& + WBorTop) + PEEKW(PEEKL(scr& + ScreenFont) + ta_YSize) + 1
  475.     lt = height + PROP_VGAP
  476.     TAGLIST VARPTR(tl&(0)), _
  477.       GA_Top&, lt, _
  478.       GA_Width&, PEEKW(sizeim& + ImageWidth) - proplgap - proprgap, _
  479.       GA_RelRight&, -PEEKW(sizeim& + ImageWidth) + proplgap + 1, _
  480.       GA_RelHeight&, -(bottomspace + lt + PEEKW(sizeim& + ImageHeight) + PEEKB(scr& + WBorBottom) + PROP_VGAP - 2), _
  481.       GA_RightBorder&, TRUE&, _
  482.       PGA_NewLook&, TRUE&, _
  483.       PGA_Borderless&, borderless&, _
  484.       PGA_Freedom&, FREEVERT&, _
  485.       PGA_Total&, 1, _
  486.       PGA_Visible&, 1, _
  487.       PGA_Top&, 0, _
  488.       TAG_END&
  489.  
  490.     newVScroller& = NewObjectA&(NULL&, SADD("propgclass" + CHR$(0)), VARPTR(tl&(0)))
  491. END FUNCTION
  492.  
  493. ' Adjust the scroller object to reflect the current window size and
  494. ' scroll offset within our document
  495. SUB SetScroller(BYVAL win&, BYVAL scroller&, _
  496.   BYVAL linesVisible&, BYVAL numLines&, BYVAL topLines&)
  497.     TAGLIST VARPTR(tl&(0)), _
  498.       PGA_Visible&, linesVisible&, _
  499.       PGA_Total&, numLines&, _
  500.       PGA_Top&, topLine&, _
  501.       TAG_END&
  502.  
  503.     junk& = SetGadgetAttrsA&(scroller&, win&, NULL&, VARPTR(tl&(0)))
  504. END SUB
  505.  
  506. SUB BusyState(BYVAL makeBusy)
  507.     SHARED taskBusy, win&
  508.  
  509.     taskBusy = makeBusy
  510.     IF makeBusy = FALSE& THEN
  511.         normalPointer win&
  512.     ELSE
  513.         busyPointer win&
  514.     END IF
  515.     IF PEEKW(PEEKL(win& + WLayer) + LayerFlags) AND LAYERREFRESH& THEN
  516.         BeginRefresh win&
  517.         RefreshView TRUE&
  518.         EndRefresh win&, TRUE&
  519.     END IF
  520. END SUB
  521.  
  522. SUB deltaLine(BYVAL n)
  523.     IF currentLine& <> NULL& THEN
  524.         IF n > 0 THEN
  525.             DO WHILE PEEKL(PEEKL(currentLine& + ln_Succ) + ln_Succ) <> NULL& AND _
  526.               n <> 0
  527.                 DECR n
  528.                 currentLine& = PEEKL(currentLine& + ln_Succ)
  529.             LOOP WHILE PEEKL(currentLine& + ln_Succ) <> NULL&
  530.         ELSEIF n < 0 THEN
  531.             DO WHILE PEEKL(PEEKL(currentLine& + ln_Pred) + ln_Pred) <> NULL& AND _
  532.               n <> 0
  533.                 INCR n
  534.                 currentLine& = PEEKL(currentLine& + ln_Pred)
  535.             LOOP WHILE PEEKL(currentLine& + ln_Pred) <> NULL&
  536.         END IF
  537.         RefreshView TRUE&
  538.     END IF
  539. END SUB
  540.  
  541. CONST VSCROLLERGA_ID = 1    ' arbitrary gadget IDs for scroller gadgets
  542. CONST VSCROLLUPGA_ID = 2
  543. CONST VSCROLLDOWNGA_ID = 3
  544.  
  545. DIM kbuf(7)    ' no more than 16 bytes
  546. DIM ie(InputEvent_sizeof \ 2)
  547.  
  548. SUB handleSignals
  549.     STATIC msg&, done, sigMask&, sigs&, actual, ckey, n, l&, gotoLine&
  550.     STATIC intuiMsgClass&, intuiMsgCode, intuiMsgMouseX, intuiMsgMouseY
  551.     STATIC leftSeconds&, leftMicros&, intuiMsgSeconds&, intuiMsgMicros&
  552.     STATIC prxArgs&
  553.     SHARED win&, vscroller&, rxPort&, fntHeight
  554.     SHARED kbuf(), ie()
  555.  
  556.     ' prepare the InputEvent structure
  557.     POKEB VARPTR(ie(0)) + ie_Class, IECLASS_RAWKEY&
  558.     POKEB VARPTR(ie(0)) + ie_SubClass, 0
  559.  
  560.     ' render the initial display
  561.     RefreshView TRUE&
  562.  
  563.     sigMask& = 1& << PEEKB(PEEKL(win& + UserPort) + mp_SigBit)
  564.     sigMask& = sigMask& OR (1& << PEEKB(rxPort& + mp_SigBit))
  565.  
  566.     done = FALSE&
  567.     BusyState FALSE&
  568.     WHILE done = FALSE&
  569.         ' if the LAYERREFRESH flag is set in the window's
  570.         ' layer, it means the layer has some damage we
  571.         ' should repair.
  572.         IF PEEKW(PEEKL(win& + WLayer) + LayerFlags) AND LAYERREFRESH& THEN
  573.             ' enter optimized repair state
  574.             BeginRefresh win&
  575.  
  576.             ' redraw the whole display through the optimized repair
  577.             ' region
  578.             RefreshView TRUE&
  579.  
  580.             ' tell the system we are done repairing the window
  581.             EndRefresh win&, TRUE&
  582.         END IF
  583.  
  584.         sigs& = xWait&(sigMask&)
  585.         gotoLine& = NULL&
  586.         IF sigs& AND (1& << PEEKB(PEEKL(win& + UserPort) + mp_SigBit)) THEN
  587.             msg& = GetMsg&(PEEKL(win& + UserPort))
  588.             WHILE msg& <> NULL&
  589.                 intuiMsgClass& = PEEKL(msg& + Class)
  590.                 intuiMsgCode = PEEKW(msg& + IntuiMessageCode)
  591.                 intuiMsgSeconds& = PEEKL(msg& + IntuiMessageSeconds)
  592.                 intuiMsgMicros& = PEEKL(msg& + IntuiMessageMicros)
  593.                 intuiMsgMouseX = PEEKW(msg& + IntuiMessageMouseX)
  594.                 intuiMsgMouseY = PEEKW(msg& + IntuiMessageMouseY)
  595.  
  596.                 ' map RawKeys to ANSI codes
  597.                 IF intuiMsgClass& = IDCMP_RAWKEY& THEN
  598.                     ' need to convert the RawKey before replying
  599.  
  600.                     POKEW VARPTR(ie(0)) + ie_Code, intuiMsgCode
  601.                     POKEW VARPTR(ie(0)) + ie_Qualifier, PEEKW(msg& + Qualifier)
  602.                     ' recover dead key codes & qualifiers
  603.                     POKEL VARPTR(ie(0)) + ie_addr, PEEKL(msg& + IAddress)
  604.                     actual = MapRawKey&(VARPTR(ie(0)), VARPTR(kbuf(0)), 16, NULL&)
  605.                 END IF
  606.  
  607.                 ReplyMsg msg&
  608.  
  609.                 SELECT CASE intuiMsgClass&
  610.                     CASE IDCMP_CLOSEWINDOW&
  611.                         ' user clicked on the close gadget, exit the program
  612.                         done = TRUE&
  613.  
  614.                     CASE IDCMP_NEWSIZE&
  615.                         ' user sized the window. We need to redraw the whole
  616.                         ' display in order to eliminate any garbage. Start by
  617.                         ' calling BeginRefresh() and EndRefresh() to eliminate
  618.                         ' the window's damage regions then completely redraw
  619.                         ' the window contents.
  620.  
  621.                         BeginRefresh win&
  622.                         EndRefresh win&, TRUE&
  623.                         RefreshView TRUE&
  624.                         SetScroller win&, vscroller&, linesVisible, numLines, topLine&
  625.  
  626.                     CASE IDCMP_REFRESHWINDOW&
  627.                         ' Intuition is telling us damage occured to our layer.
  628.                         ' Don't bother doing anything, the check at the top of the
  629.                         ' loop will catch this fact and refresh the display
  630.                         '
  631.                         ' Even though we don't do anything with these events, we
  632.                         ' still need them to be sent to us so we will wake up and
  633.                         ' look at the LAYERREFRESH bit.
  634.  
  635.                     CASE IDCMP_RAWKEY&:
  636.                         ' decode the keystroke
  637.  
  638.                         SELECT CASE actual
  639.                             CASE 1
  640.                                 ckey = PEEKB(VARPTR(kbuf(0))) AND &hFF
  641.                                 SELECT CASE ckey
  642.                                     CASE &h0D    ' CR
  643.                                         gotoLine& = currentLine&
  644.                                 END SELECT
  645.  
  646.                             CASE 2
  647.                                 ckey = kbuf(0)
  648.                                 n = 0
  649.                                 SELECT CASE ckey
  650.                                     CASE &h9B41    ' cursor up
  651.                                         n = -1
  652.  
  653.                                     CASE &h9B42    ' cursor down
  654.                                         n = 1
  655.  
  656.                                     CASE &h9B54    ' shift cursor up
  657.                                         n = -(linesVisible - 1)
  658.  
  659.                                     CASE &h9B53    ' shift cursor down
  660.                                         n = linesVisible - 1
  661.                                 END SELECT
  662.                                 IF n <> 0 THEN
  663.                                     deltaLine n
  664.                                 END IF
  665.                         END SELECT
  666.  
  667.                     CASE IDCMP_MOUSEBUTTONS&
  668.                         IF intuiMsgCode = SELECTDOWN& THEN
  669.                             n = (intuiMsgMouseY - PEEKB(win& + BorderTop)) \ fntHeight
  670.                             IF n < 0 THEN
  671.                                 n = 0
  672.                             ELSEIF n >= linesVisible THEN
  673.                                 n = linesVisible - 1
  674.                             END IF
  675.                             currentLine& = firstVisibleLine&
  676.                             deltaLine n
  677.                             IF DoubleClick(leftSeconds&, leftMicros&, _
  678.                               intuiMsgSeconds&, intuiMsgMicros&) THEN
  679.                                 gotoLine& = currentLine&
  680.                                 leftSeconds& = 0
  681.                                 leftMicros& = 0
  682.                             ELSE
  683.                                 leftSeconds& = intuiMsgSeconds&
  684.                                 leftMicros& = intuiMsgMicros&
  685.                             END IF
  686.                         END IF
  687.  
  688.                     CASE IDCMP_IDCMPUPDATE&
  689.                         SELECT CASE intuiMsgCode
  690.                             CASE VSCROLLERGA_ID
  691.                                 ' user is playing with the scroller. Get the
  692.                                 ' scroller's current top line and synchronize
  693.                                 ' the display to match it
  694.  
  695.                                 junk& = GetAttr&(PGA_Top&, vscroller&, VARPTR(topLine&))
  696.                                 RefreshView FALSE&
  697.  
  698.                             CASE VSCROLLUPGA_ID
  699.                                 ' click on the up gadget, act on it if enough lines
  700.                                 ' available
  701.                                 IF topLine& > 0 THEN
  702.                                     DECR topLine&
  703.                                     ' update the top line
  704.                                     TAGLIST VARPTR(tl&(0)), _
  705.                                       PGA_Top&, topLine&, _
  706.                                       TAG_END&
  707.                                     junk& = SetGadgetAttrsA&(vscroller&, win&, NULL&, VARPTR(tl&(0)))
  708.                                     RefreshView FALSE&
  709.                                 END IF
  710.  
  711.                             CASE VSCROLLDOWNGA_ID
  712.                                 ' click on the down gadget, act on it if enough lines
  713.                                 ' available
  714.                                 IF topLine& + linesVisible < numLines THEN
  715.                                     INCR topLine&
  716.                                     ' update the top line
  717.                                     TAGLIST VARPTR(tl&(0)), _
  718.                                       PGA_Top&, topLine&, _
  719.                                       TAG_END&
  720.                                     junk& = SetGadgetAttrsA&(vscroller&, win&, NULL&, VARPTR(tl&(0)))
  721.                                     RefreshView FALSE&
  722.                                 END IF
  723.                         END SELECT
  724.                 END SELECT
  725.                 IF gotoLine& <> NULL& THEN
  726.                     prxArgs& = gotoLine& + Node_sizeof + 4
  727.  
  728.                     ' start the NewMsg script with the original parameters
  729.                     junk& = issueRXCommand&(rxPort&, _
  730.                       "NewMsg " + _
  731.                       """" + PEEK$(PEEKL(prxArgs& + 0 * 4)) + """" + " " + _
  732.                       """" + PEEK$(PEEKL(prxArgs& + 1 * 4)) + """" + " " + _
  733.                       LTRIM$(STR$(PEEKL(PEEKL(prxArgs& + 2 * 4)))) + " " + _
  734.                       LTRIM$(STR$(PEEKL(PEEKL(prxArgs& + 3 * 4)))) + " " + _
  735.                       """" + PEEK$(PEEKL(prxArgs& + 4 * 4)) + """" + " " + _
  736.                       LTRIM$(STR$(PEEKL(PEEKL(prxArgs& + 5 * 4)))) + " " + _
  737.                       """" + PEEK$(PEEKL(prxArgs& + 6 * 4)) + """" + " " + _
  738.                       LTRIM$(STR$(PEEKL(PEEKL(prxArgs& + 7 * 4)))) + " " + _
  739.                       """" + PEEK$(PEEKL(prxArgs& + 8 * 4)) + """", _
  740.                       "rexx")
  741.                 END IF
  742.                 msg& = GetMsg&(PEEKL(win& + UserPort))
  743.             WEND
  744.         END IF
  745.         IF sigs& AND (1& << PEEKB(rxPort& + mp_SigBit)) THEN
  746.             BusyState TRUE&
  747.             msg& = GetMsg&(rxPort&)
  748.             WHILE msg& <> NULL&
  749.                 IF PEEKB(msg& + rm_Node + mn_Node + ln_Type) = NT_REPLYMSG& THEN
  750.                     disposeRXCommand rxPort&, msg&
  751.                 ELSE
  752.                     done = dispatchRXMsg(PEEK$(PEEKL(msg& + rm_Args)))
  753.                     ReplyMsg msg&
  754.                 END IF
  755.                 msg& = GetMsg&(rxPort&)
  756.             WEND
  757.             BusyState FALSE&
  758.  
  759.             IF PEEKW(PEEKL(win& + WLayer) + LayerFlags) AND LAYERREFRESH& THEN
  760.                 ' eat the refresh if there was one pending
  761.                 BeginRefresh win&
  762.                 EndRefresh win&, TRUE&
  763.             END IF
  764.             RefreshView TRUE&    ' refresh for the new string
  765.  
  766.             ' update the slider size
  767.             TAGLIST VARPTR(tl&(0)), _
  768.               PGA_Total&, numLines, _
  769.               TAG_END&
  770.  
  771.             junk& = SetGadgetAttrsA&(vscroller&, win&, NULL&, VARPTR(tl&(0)))
  772.         END IF
  773.     WEND
  774. END SUB
  775.  
  776. DIM refreshHook(Hook_sizeof \ 2)
  777. DIM icaGaIdToICSpecial&(2)
  778.  
  779. FUNCTION main(BYVAL template&)
  780.     STATIC node&, driFillPen, wrMask, currentPos&, currentLength&, rdArgs&, myRDArgs&
  781.     STATIC msg&, wbArg&, diskObj&, tmplock&, toolTypes&, totalString&, totalSize&, r
  782.     SHARED scr&, dri&, win&, rxPort&, refreshHook(), icaGaIdToICSpecial&()
  783.     SHARED vscroller&, vupbutton&, vdownbutton&, sizeim&, upim&, downim&
  784.     SHARED taskBusy, fntHeight
  785.  
  786.     r = RETURN_FAIL&
  787.  
  788.     ' find out if WB or CLI launched
  789.     msg& = PEEKL(SYSTAB + 8)
  790.     IF msg& <> NULL& THEN
  791.         ' Started from Workbench so do icon magic...
  792.         '
  793.         ' What we will do here is try all of the tooltypes
  794.         ' in the icon and keep only those which do not cause
  795.         ' errors in the RDArgs.
  796.  
  797.         wbArg& = PEEKL(msg& + sm_ArgList)
  798.  
  799.         ' Use project icon if it is there...
  800.         IF PEEKL(msg& + sm_NumArgs) > 1 THEN
  801.             wbArg& = wbArg& + 4
  802.         END IF
  803.  
  804.         tmplock& = CurrentDir&(PEEKL(wbArg& + wa_Lock))
  805.         diskObj& = GetDiskObject&(PEEKL(wbArg& + wa_Name))
  806.         IF diskObj& <> NULL& THEN
  807.             toolTypes& = PEEKL(diskObj& + do_ToolTypes)
  808.             IF toolTypes& <> NULL& THEN
  809.                 totalSize& = 3
  810.  
  811.                 WHILE PEEKL(toolTypes&)
  812.                     totalSize& = totalSize& + LEN(PEEK$(PEEKL(toolTypes&))) + 1
  813.                     toolTypes& = toolTypes& + 4
  814.                 WEND
  815.  
  816.                 totalString& = LibAllocPooled&(pool&, totalSize&)
  817.                 IF totalString& <> NULL& THEN
  818.                     currentPos& = totalString&
  819.                     toolTypes& = PEEKL(diskObj& + do_ToolTypes)
  820.                     DO
  821.                         POKEB currentPos&, 0
  822.                         IF PEEKL(toolTypes&) THEN
  823.                             CopyMem PEEKL(toolTypes&), currentPos&, LEN(PEEK$(PEEKL(toolTypes&)))
  824.                         END IF
  825.                         currentLength& = LEN(PEEK$(currentPos&))
  826.                         POKEB currentPos& + currentLength& + 0, &h0A
  827.                         POKEB currentPos& + currentLength& + 1, &h00
  828.  
  829.                         IF rdargs& THEN
  830.                             FreeArgs rdargs&
  831.                         END IF
  832.                         rdargs& = NULL&
  833.  
  834.                         IF myRDArgs& <> NULL& THEN
  835.                             FreeDosObject DOS_RDARGS&, myRDArgs&
  836.                         END IF
  837.                         myRDArgs& = AllocDosObject&(DOS_RDARGS&, NULL&)
  838.                         IF myRDArgs& <> NULL& THEN
  839.                             POKEL myRDArgs& + RDA_Source + CS_Buffer, totalString&
  840.                             POKEL myRDArgs& + RDA_Source + CS_Length, LEN(PEEK$(totalString&))
  841.  
  842.                             rdargs& = ReadArgs&(template&, VARPTR(opts&(0)), myRDArgs&)
  843.                             IF rdargs& <> NULL& THEN
  844.                                 POKEB currentPos& + currentLength&, ASC(" ")
  845.                                 currentPos& = currentPos& + currentLength& + 1
  846.                             END IF
  847.                         END IF
  848.                         toolTypes& = toolTypes& + 4
  849.                     LOOP WHILE PEEKL(toolTypes& - 4) <> NULL&
  850.                     LibFreePooled pool&, totalString&, totalSize&
  851.                 END IF
  852.             END IF
  853.             FreeDiskObject diskObj&
  854.         END IF
  855.         junk& = CurrentDir&(tmplock&)
  856.         r = RETURN_OK&
  857.     ELSE
  858.         ' Started from CLI so do standard ReadArgs
  859.  
  860.         rdargs& = ReadArgs&(template&, VARPTR(opts&(0)), NULL&)
  861.         IF rdargs& = NULL& THEN
  862.             junk& = PrintFault&(IoErr&, NULL&)
  863.         ELSEIF SetSignal&(0, 0) AND SIGBREAKF_CTRL_C& THEN
  864.             junk& = PrintFault&(ERROR_BREAK&, NULL&)
  865.         ELSE
  866.             r = RETURN_OK&
  867.         END IF
  868.     END IF
  869.  
  870.     IF r = RETURN_OK& THEN
  871.         r = RETURN_FAIL&
  872.  
  873.         ' Allocate a list to store the message nodes
  874.         errList& = LibAllocPooled&(pool&, List_sizeof)
  875.         NewList errList&
  876.  
  877.         scr& = LockPubScreen&(opts&(OPT_PUBSCREEN))
  878.         IF scr& = NULL& THEN
  879.             ' fall back to the Workbench screen
  880.             scr& = LockPubScreen&(NULL&)
  881.         END IF
  882.         IF scr& <> NULL& THEN
  883.             dri& = GetScreenDrawInfo&(scr&)
  884.             IF dri& <> NULL& THEN
  885.                 ' obtain a size gadget image (for metric purposes)
  886.                 TAGLIST VARPTR(tl&(0)), _
  887.                   SYSIA_Which&, SIZEIMAGE&, _
  888.                   SYSIA_DrawInfo&, dri&, _
  889.                   TAG_END&
  890.                 sizeim& = NewObjectA&(NULL&, SADD("sysiclass" + CHR$(0)), VARPTR(tl&(0)))
  891.  
  892.                 ' obtain a up arrow image
  893.                 TAGLIST VARPTR(tl&(0)), _
  894.                   SYSIA_Which&, UPIMAGE&, _
  895.                   SYSIA_DrawInfo&, dri&, _
  896.                   TAG_END&
  897.                 upim& = NewObjectA&(NULL&, SADD("sysiclass" + CHR$(0)), VARPTR(tl&(0)))
  898.  
  899.                 ' obtain a down arrow image
  900.                 TAGLIST VARPTR(tl&(0)), _
  901.                   SYSIA_Which&, DOWNIMAGE&, _
  902.                   SYSIA_DrawInfo&, dri&, _
  903.                   TAG_END&
  904.                 downim& = NewObjectA&(NULL&, SADD("sysiclass" + CHR$(0)), VARPTR(tl&(0)))
  905.  
  906.                 IF sizeim& <> NULL& AND upim& <> NULL& AND downim& <> NULL& THEN
  907.                     vscroller& = newVScroller&(PEEKW(upim& + ImageHeight) + PEEKW(downim& + ImageHeight))
  908.                     IF vscroller& <> NULL& THEN
  909.                         ' ICA_MAP to stuff gadget ID into the IntuiMessageCode field
  910.                         TAGLIST VARPTR(icaGaIdToICSpecial&(0)), _
  911.                           GA_ID&, ICSPECIAL_CODE&, _
  912.                           TAG_END&
  913.  
  914.                         ' connect the scroller to the IDCMP
  915.                         TAGLIST VARPTR(tl&(0)), _
  916.                           GA_ID&, VSCROLLERGA_ID, _
  917.                           ICA_TARGET&, ICTARGET_IDCMP&, _
  918.                           ICA_MAP&, VARPTR(icaGaIdToICSpecial&(0)), _
  919.                           TAG_END&
  920.                         junk& = SetAttrsA&(vscroller&, VARPTR(tl&(0)))
  921.  
  922.                         ' create up button
  923.                         TAGLIST VARPTR(tl&(0)), _
  924.                           GA_ID&, VSCROLLUPGA_ID, _
  925.                           GA_Image&, upim&, _
  926.                           GA_RelBottom&, -(PEEKW(sizeim& + ImageHeight) + PEEKW(upim& + ImageHeight) + PEEKW(downim& + ImageHeight)) + 1, _
  927.                           GA_Width&, PEEKW(upim& + ImageWidth), _
  928.                           GA_RelRight&, -PEEKW(upim& + ImageWidth) + 1, _
  929.                           GA_Height&, -PEEKW(upim& + ImageHeight) + 1, _
  930.                           GA_Highlight&, GFLG_GADGHIMAGE&, _
  931.                           GA_RightBorder&, TRUE&, _
  932.                           ICA_TARGET&, ICTARGET_IDCMP&, _
  933.                           ICA_MAP&, VARPTR(icaGaIdToICSpecial&(0)), _
  934.                           GA_Previous&, vscroller&, _
  935.                           TAG_END&
  936.                         vupbutton& = NewObjectA(NULL&, SADD("buttongclass" + CHR$(0)), VARPTR(tl&(0)))
  937.  
  938.                         ' create down button
  939.                         TAGLIST VARPTR(tl&(0)), _
  940.                           GA_ID&, VSCROLLDOWNGA_ID, _
  941.                           GA_Image&, downim&, _
  942.                           GA_RelBottom&, -(PEEKW(sizeim& + ImageHeight) + PEEKW(downim& + ImageHeight)) + 1, _
  943.                           GA_Width&, PEEKW(downim& + ImageWidth), _
  944.                           GA_RelRight&, -PEEKW(downim& + ImageWidth) + 1, _
  945.                           GA_Height&, -PEEKW(downim& + ImageHeight) + 1, _
  946.                           GA_Highlight&, GFLG_GADGHIMAGE&, _
  947.                           GA_RightBorder&, TRUE&, _
  948.                           ICA_TARGET&, ICTARGET_IDCMP&, _
  949.                           ICA_MAP&, VARPTR(icaGaIdToICSpecial&(0)), _
  950.                           GA_Previous&, vupbutton&, _
  951.                           TAG_END&
  952.                         vdownbutton& = NewObjectA(NULL&, SADD("buttongclass" + CHR$(0)), VARPTR(tl&(0)))
  953.  
  954.                         IF vupbutton& <> NULL& AND vdownbutton& <> NULL& THEN
  955.                             ' initialise an optimized backfill hook
  956.                             INITHOOK VARPTR(refreshHook(0)), VARPTRS(BackFillHook)
  957.                             TAGLIST VARPTR(tl&(0)), _
  958.                               WA_PubScreen&, scr&, _
  959.                               WA_AutoAdjust&, TRUE&, _
  960.                               WA_CloseGadget&, TRUE&, _
  961.                               WA_DepthGadget&, TRUE&, _
  962.                               WA_DragBar&, TRUE&, _
  963.                               WA_SizeGadget&, TRUE&, _
  964.                               WA_SizeBRight&, TRUE&, _
  965.                               WA_SimpleRefresh&, TRUE&, _
  966.                               WA_Activate&, TRUE&, _
  967.                               WA_Gadgets&, vscroller&, _
  968.                               WA_MinWidth&, PEEKW(sizeim& + ImageWidth) * 5, _
  969.                               WA_MinHeight&, _
  970.                                 PEEKW(sizeim& + ImageWidth) + _
  971.                                 PEEKW(upim& + ImageWidth) + _
  972.                                 PEEKW(downim& + ImageWidth) + _
  973.                                 (PEEKW(PEEKL(scr& + ScreenFont) + ta_YSize) + 1) * 2, _
  974.                               WA_MaxWidth&, -1, _
  975.                               WA_MaxHeight&, -1, _
  976.                               WA_NewLookMenus&, TRUE&, _
  977.                               WA_IDCMP&, _
  978.                                 IDCMP_CLOSEWINDOW& OR _
  979.                                 IDCMP_NEWSIZE& OR _
  980.                                 IDCMP_REFRESHWINDOW& OR _
  981.                                 IDCMP_RAWKEY& OR _
  982.                                 IDCMP_MOUSEBUTTONS& OR _
  983.                                 IDCMP_IDCMPUPDATE&, _
  984.                               WA_BackFill&, VARPTR(refreshHook(0)), _
  985.                               TAG_END&
  986.  
  987.                             taskBusy = TRUE&
  988.                             win& = OpenWindowTagList&(NULL&, VARPTR(tl&(0)))
  989.                             IF win& <> NULL& THEN
  990.                                 fntHeight = PEEKW(PEEKL(PEEKL(win& + RPort) + RastPortFont) + tf_YSize)
  991.                                 driFillPen = PEEKW(PEEKL(dri& + dri_Pens) + FILLPEN& * 2)
  992.  
  993.                                 ' initialize rendering attributes we are going to use
  994.                                 CopyMem PEEKL(win& + RPort), VARPTR(render(0)), RastPort_sizeof
  995.                                 SetDrMd VARPTR(render(0)), JAM2&
  996.                                 SetAPen VARPTR(render(0)), PEEKW(PEEKL(dri& + dri_Pens) + TEXTPEN& * 2)
  997.  
  998.                                 ' initialize selected rendering attributes
  999.                                 CopyMem PEEKL(win& + RPort), VARPTR(selren(0)), RastPort_sizeof
  1000.                                 SetDrMd VARPTR(selren(0)), JAM2&
  1001.                                 SetAPen VARPTR(selren(0)), PEEKW(PEEKL(dri& + dri_Pens) + FILLTEXTPEN& * 2)
  1002.                                 SetBPen VARPTR(selren(0)), driFillPen
  1003.  
  1004.                                 ' initialize clearing attributes we are going to use
  1005.                                 CopyMem PEEKL(win& + RPort), VARPTR(clr(0)), RastPort_sizeof
  1006.                                 SetDrMd VARPTR(clr(0)), JAM2&
  1007.                                 SetAPen VARPTR(clr(0)), PEEKW(PEEKL(dri& + dri_Pens) + BACKGROUNDPEN& * 2)
  1008.  
  1009.                                 ' set write masks for the RastPorts
  1010.                                 IF PEEKW(PEEKL(dri& + dri_Pens) + FILLTEXTPEN& * 2) > driFillPen THEN
  1011.                                     driFillPen = PEEKW(PEEKL(dri& + dri_Pens) + FILLTEXTPEN& * 2)
  1012.                                 END IF
  1013.                                 IF PEEKW(LIBRARY("graphics.library") + GfxBaseLibNode + lib_Version) >= 39 THEN
  1014.                                     SetMaxPen VARPTR(render(0)), driFillPen
  1015.                                     SetMaxPen VARPTR(selren(0)), driFillPen
  1016.                                     SetMaxPen VARPTR(clr(0)), driFillPen
  1017.                                 ELSE
  1018.                                     ' compute the write mask with driFillPen as the
  1019.                                     ' maximum pen
  1020.                                     DO
  1021.                                         wrMask = driFillPen AND -driFillPen
  1022.                                         driFillPen = driFillPen AND NOT wrMask
  1023.                                     LOOP UNTIL driFillPen = 0
  1024.                                     wrMask = (1 << wrMask) - 1
  1025.                                     SetWrMsk VARPTR(render(0)), wrMask
  1026.                                     SetWrMsk VARPTR(selren(0)), wrMask
  1027.                                     SetWrMsk VARPTR(clr(0)), wrMask
  1028.                                 END IF
  1029.  
  1030.                                 IF opts&(OPT_PORTNAME) <> NULL& THEN
  1031.                                     rxPort& = createRXPort&(opts&(OPT_PORTNAME))
  1032.                                 ELSE
  1033.                                     rxPort& = createRXPort&(SADD("HBMSG" + CHR$(0)))
  1034.                                 END IF
  1035.                                 IF rxPort& <> NULL& THEN
  1036.                                     ' handle the programs events
  1037.                                     handleSignals
  1038.  
  1039.                                     BusyState TRUE&
  1040.                                     ' dispose of all remaining nodes on the error list
  1041.                                     node& = RemHead&(errList&)
  1042.                                     WHILE node& <> NULL&
  1043.                                         disposeRXArgs PEEKL(node& + Node_sizeof)
  1044.                                         LibFreeVecPooled pool&, node&
  1045.                                         node& = RemHead&(errList&)
  1046.                                     WEND
  1047.                                     main = RETURN_OK&
  1048.                                     disposeRXPort rxPort&
  1049.                                 END IF
  1050.                                 CloseWindow win&
  1051.                             END IF
  1052.                             DisposeObject vupbutton&
  1053.                             DisposeObject vdownbutton&
  1054.                         END IF
  1055.                         DisposeObject vscroller&
  1056.                     END IF
  1057.                 END IF
  1058.                 DisposeObject downim&    ' DisposeObject NULL& is safe
  1059.                 DisposeObject upim&
  1060.                 DisposeObject sizeim&
  1061.                 FreeScreenDrawInfo scr&, dri&
  1062.             END IF
  1063.             UnlockPubScreen NULL&, scr&
  1064.         END IF
  1065.     END IF
  1066.     IF rdargs& THEN
  1067.         FreeArgs rdargs&
  1068.     END IF
  1069.     IF myRDArgs& THEN
  1070.         FreeDosObject DOS_RDARGS&, myRDArgs&
  1071.     END IF
  1072.     main = r
  1073. END FUNCTION
  1074.  
  1075. allocBusyPointer
  1076. pool& = LibCreatePool&(MEMF_ANY& OR MEMF_CLEAR&, 8192, 4096)    ' create a pool for our allocations
  1077. IF pool& <> NULL& THEN
  1078.     r = main(SADD("PUBSCREEN/K,PORTNAME/K" + CHR$(0)))
  1079.     LibDeletePool pool&    ' takes all allocated memory with it
  1080. ELSE
  1081.     r = RETURN_FAIL
  1082. END IF
  1083. freeBusyPointer
  1084. SYSTEM r
  1085.